home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / coerce / coerce.bas next >
Encoding:
BASIC Source File  |  1995-05-09  |  1.3 KB  |  48 lines
  1. ' This routine by Bud Aaron
  2. ' Small Packages, 4052 Johnson Drive, Oceanside CA 92056
  3. ' (619) 724-4840 is hereby placed in public domain
  4. ' for all to use in whatever way they choose.
  5. '
  6. ' If you find problems, please give me a call
  7. Function Coerce (Value As Currency, Places As Long)
  8.   Dim DecimalPart As Currency
  9.   Dim Factor As Integer
  10.  
  11.   If Places = 1000 Then Value = Value * .001
  12.   If Places = 1000000 Then Value = Value * .000001
  13.  
  14.   DecimalPart = Value - Int(Value)
  15.   Select Case Places
  16.     Case 0     ' Dollar coercion with rounding
  17.       Factor = 1
  18.       GoSub RoundIt
  19.     Case 1     ' Tenths (1 decimal place) coercion
  20.       Factor = 10
  21.       GoSub RoundIt
  22.     Case 2     ' Hundredths (2 decimal place) coercion
  23.       Factor = 100
  24.       GoSub RoundIt
  25.     Case 3     ' Thousandths (3 decimal place) coercion
  26.       Factor = 1000
  27.       GoSub RoundIt
  28.     Case 1000  ' Coerce to Thousands with rounding
  29.       Factor = 1
  30.       GoSub RoundIt
  31.     Case 1000000      ' Coerce to Millions with rounding
  32.       Factor = 1
  33.       GoSub RoundIt
  34.   End Select
  35. Exit Function
  36.  
  37. RoundIt:
  38.   DecimalPart = DecimalPart * Factor
  39.     If DecimalPart - Int(DecimalPart) >= .5 Then
  40.       DecimalPart = DecimalPart + 1
  41.     End If
  42.  
  43.   DecimalPart = Int(DecimalPart) / Factor
  44.   Value = Int(Value) + DecimalPart
  45. Return
  46. End Function
  47.  
  48.